home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_s.arc / ICONX.ARC / FMATH.C < prev    next >
Encoding:
C/C++ Source or Header  |  1990-03-28  |  5.5 KB  |  291 lines

  1.  
  2. /*
  3.  * fmath.c -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
  4.  */
  5.  
  6. #include <math.h>
  7. #include "..\h\config.h"
  8. #include "..\h\rt.h"
  9. #include "rproto.h"
  10.  
  11. #ifdef MathFncs
  12. /*
  13.  * The following code is operating-system dependent [@fmath.01].  Include
  14.  *  system-dependent files and declarations.
  15.  */
  16.  
  17. #if PORT
  18.    /* probably #include <errno.h> */
  19. #endif                    /* PORT */
  20.  
  21. #if AMIGA || HIGHC_386 || MACINTOSH || VMS
  22. #include <errno.h>
  23. #endif                    /* AMIGA || HIGHC_386 ... */
  24.  
  25. #if ATARI_ST
  26. #if LATTICE
  27. #include <error.h>
  28. #else                    /* LATTICE */
  29. #include <errno.h>
  30. #endif                    /* LATTICE */
  31. #endif                    /* ATARI_ST */
  32.  
  33. #if MSDOS
  34. #if !MWC
  35. #include <errno.h>
  36. #endif                    /* !MWC */
  37. #if MICROSOFT
  38. int errno;
  39. #endif                    /* MICROSOFT */
  40. #endif                    /* MSDOS */
  41.  
  42. #if OS2
  43. #if MICROSOFT
  44. int errno;
  45. #endif                    /* MICROSOFT */
  46. #endif                    /* OS2 */
  47.  
  48. #if MVS || VM
  49. #include <errno.h>
  50. #ifdef SASC
  51. #include <lcmath.h>
  52. #define PI M_PI
  53. #endif                    /* SASC */
  54. #endif                    /* MVS || VM */
  55.  
  56. #if UNIX
  57. #include <errno.h>
  58. int errno;
  59. #endif                    /* UNIX */
  60.  
  61. /*
  62.  * End of operating-system specific code.
  63.  */
  64.  
  65. #ifndef PI
  66. #define PI 3.14159
  67. #endif                    /* PI */
  68.  
  69.  
  70. /*
  71.  * sin(x), x in radians
  72.  */
  73.  
  74. FncDcl(sin,1)
  75.    {
  76.    int t;
  77.    double sin();
  78.  
  79.    if ((t = cvreal(&Arg1)) == CvtFail) 
  80.      RunErr(102, &Arg1);
  81.    if (makereal(sin(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  82.       RunErr(0, NULL);
  83.    Return;
  84.    }
  85.  
  86. /*
  87.  * cos(x), x in radians
  88.  */
  89.  
  90. FncDcl(cos,1)
  91.    {
  92.    int t;
  93.  
  94.    if ((t = cvreal(&Arg1)) == CvtFail) 
  95.       RunErr(102, &Arg1);
  96.    if (makereal(cos(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  97.       RunErr(0, NULL);
  98.    Return;
  99.    }
  100.  
  101. /*
  102.  * tan(x), x in radians
  103.  */
  104.  
  105. FncDcl(tan,1)
  106.    {
  107.    int t;
  108.    double y;
  109.  
  110.    if ((t = cvreal(&Arg1)) == CvtFail) 
  111.       RunErr(102, &Arg1);
  112.    errno = 0;
  113.    y = tan(BlkLoc(Arg1)->realblk.realval);
  114.    if (errno == ERANGE) 
  115.       RunErr(-204, NULL);
  116.    if (makereal(y, &Arg0) == Error) 
  117.       RunErr(0, NULL);
  118.    Return;
  119.    }
  120.  
  121. /*
  122.  * acos(x), x in radians
  123.  */
  124. FncDcl(acos,1)
  125.    {
  126.    int t;
  127.    double r, y;
  128.  
  129.    if ((t = cvreal(&Arg1)) == CvtFail) 
  130.       RunErr(102, &Arg1);
  131.    r = BlkLoc(Arg1)->realblk.realval;
  132.    if (r < -1.0 || r > 1.0)        /* can't count on library */
  133.       RunErr(205,&Arg1);
  134.    errno = 0;
  135.    y = acos(r);
  136.    if (errno == EDOM) 
  137.       RunErr(-205, NULL);
  138.    if (makereal(y, &Arg0) == Error) 
  139.       RunErr(0, NULL);
  140.    Return;
  141.    }
  142.  
  143. /*
  144.  * asin(x), x in radians
  145.  */
  146. FncDcl(asin,1)
  147.    {
  148.    int t;
  149.    double r, y;
  150.  
  151.    if ((t = cvreal(&Arg1)) == CvtFail) 
  152.       RunErr(102, &Arg1);
  153.    r = BlkLoc(Arg1)->realblk.realval;
  154.    if (r < -1.0 || r > 1.0)        /* can't count on library */
  155.       RunErr(205,&Arg1);
  156.    errno = 0;
  157.    y = asin(r);
  158.    if (errno == EDOM) 
  159.       RunErr(-205, NULL);
  160.    if (makereal(y, &Arg0) == Error) 
  161.       RunErr(0, NULL);
  162.    Return;
  163.    }
  164.  
  165. /*
  166.  * atan(x,y) -- x,y  in radians; if y is present, produces atan2(x,y).
  167.  */
  168. FncDcl(atan,2)
  169.    {
  170.    int t;
  171.  
  172.    if ((t = cvreal(&Arg1)) == CvtFail) 
  173.       RunErr(102, &Arg1);
  174.    if (ChkNull(Arg2)) {
  175.       if (makereal(atan(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  176.          RunErr(0, NULL);
  177.       }
  178.    else {
  179.       if ((t = cvreal(&Arg2)) == CvtFail) 
  180.          RunErr(102, &Arg2);
  181.       if (makereal(atan2(BlkLoc(Arg1)->realblk.realval,
  182.                BlkLoc(Arg2)->realblk.realval), &Arg0) == Error) 
  183.          RunErr(0, NULL);
  184.       }
  185.    Return;
  186.    }
  187.  
  188. /*
  189.  * dtor(x), x in degrees
  190.  */
  191.  
  192. FncDcl(dtor,1)
  193.    {
  194.  
  195.    if (cvreal(&Arg1) == CvtFail) 
  196.       RunErr(102, &Arg1);
  197.    if (makereal(BlkLoc(Arg1)->realblk.realval * PI / 180, &Arg0) == Error) 
  198.       RunErr(0, NULL);
  199.    Return;
  200.    }
  201.  
  202. /*
  203.  * rtod(x), x in radians
  204.  */
  205. FncDcl(rtod,1)
  206.    {
  207.  
  208.    if (cvreal(&Arg1) == CvtFail) 
  209.       RunErr(102, &Arg1);
  210.    if (makereal(BlkLoc(Arg1)->realblk.realval * 180 / PI, &Arg0) == Error) 
  211.       RunErr(0, NULL);
  212.    Return;
  213.    }
  214.  
  215. /*
  216.  * exp(x)
  217.  */
  218.  
  219. FncDcl(exp,1)
  220.    {
  221.    int t;
  222.    double y;
  223.  
  224.    if ((t = cvreal(&Arg1)) == CvtFail) 
  225.       RunErr(102, &Arg1);
  226.    errno = 0;
  227.    y = exp(BlkLoc(Arg1)->realblk.realval);
  228.    if (errno == ERANGE) 
  229.       RunErr(-204, NULL);
  230.    if (makereal(y, &Arg0) == Error) 
  231.       RunErr(0, NULL);
  232.    Return;
  233.    }
  234.  
  235. /*
  236.  * log(x,b) - logarithm of x to base b.
  237.  */
  238. FncDcl(log,2)
  239.    {
  240.    static double lastbase = 0.0;
  241.    static double divisor;
  242.    double x;
  243.  
  244.    if (cvreal(&Arg1) != T_Real)
  245.       RunErr(102, &Arg1);
  246.    if (BlkLoc(Arg1)->realblk.realval <= 0.0)
  247.       RunErr(205, &Arg1);
  248.    x = log(BlkLoc(Arg1)->realblk.realval);
  249.    if (! ChkNull(Arg2))  {
  250.       if (cvreal(&Arg2) != T_Real)
  251.          RunErr(102, &Arg2);
  252.       if (BlkLoc(Arg2)->realblk.realval <= 1.0)
  253.          RunErr(205, &Arg2);
  254.       if (BlkLoc(Arg2)->realblk.realval != lastbase) {
  255.          divisor = log(BlkLoc(Arg2)->realblk.realval);
  256.          lastbase = BlkLoc(Arg2)->realblk.realval;
  257.          }
  258.       x = x / divisor;
  259.       }  
  260.    if (makereal(x, &Arg0) == Error)
  261.       RunErr(0, NULL);
  262.    Return;
  263.    }
  264.  
  265.  
  266. /*
  267.  * sqrt(x)
  268.  */
  269.  
  270. FncDcl(sqrt,1)
  271.    {
  272.    int t;
  273.    double r, y;
  274.  
  275.    if ((t = cvreal(&Arg1)) == CvtFail) 
  276.       RunErr(102, &Arg1);
  277.    r = BlkLoc(Arg1)->realblk.realval;
  278.    if (r < 0)
  279.       RunErr(205, &Arg1);
  280.    y = sqrt(r);
  281.    errno = 0;
  282.    if (errno == EDOM) 
  283.       RunErr(-205, NULL);
  284.    if (makereal(y, &Arg0) == Error) 
  285.       RunErr(0, NULL);
  286.    Return;
  287.    }
  288. #else                    /* MathFncs */
  289. static char x;            /* prevent empty module */
  290. #endif                    /* MathFncs */
  291.